home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor2 / xmenu.s < prev    next >
Text File  |  1993-02-18  |  11KB  |  330 lines
  1.      TITLE Expanded Menus, Version 1.03
  2. **** xmenu.s ***********************************************
  3. **
  4. ** File:    Version 1.03, 12/29/92
  5. ** Author:  Brian Maguire
  6. **
  7.  
  8. ************************************************************
  9. RPL
  10. ************************************************************
  11. * Unfrozen entries
  12. ************************************************************
  13. *
  14. * The following entries have not changed in ROM versions
  15. * A-J.  Since they are unfrozen, it is possible that they
  16. * will be moved in future ROM versions.
  17.  
  18. ASSEMBLE
  19. =SetDA3Bad     EQU  #394F9
  20. =MenuDef@      EQU  #418A4
  21. =SHRINKVDISP   EQU  #130CA
  22. RPL
  23.  
  24. ************************************************************
  25. * Local lambda definitions
  26. ************************************************************
  27.  
  28. DEFINE    getlines@ 7GETLAM   ( sub-routine : -> MenuLines )
  29. DEFINE    domnukey@ 6GETLAM   ( menu key eval. sub-routine )
  30. DEFINE    xmlines@  5GETLAM   ( # of disp lines for menu )
  31. DEFINE    xmrow@    4GETLAM   ( first menu row of page )
  32. DEFINE    xmpath@   3GETLAM   ( menu path used by UP )
  33. DEFINE    xmnext@   2GETLAM   ( more rows below? )
  34. DEFINE    xmexit@   1GETLAM   ( exit flag )
  35.  
  36. DEFINE    getlines! 7PUTLAM
  37. DEFINE    domnukey! 6PUTLAM
  38. DEFINE    xmlines!  5PUTLAM
  39. DEFINE    xmrow!    4PUTLAM
  40. DEFINE    xmpath!   3PUTLAM
  41. DEFINE    xmnext!   2PUTLAM
  42. DEFINE    xmexit!   1PUTLAM
  43.  
  44. ************************************************************
  45.  
  46. NULLNAME XMENU ( -->  )
  47.  
  48. ::
  49.      CK0
  50.      POLSaveUI ERRSET
  51.      ::
  52.  
  53. **  Sub-routine to set MenuLines.  If the menu data is not a
  54. **  list then default to  4.
  55.  
  56.      '
  57.      ::
  58.           DoFirstRow
  59.           MenuDef@ EVAL       ( return menu data )
  60.           DUPTYPELIST?
  61.           ITE
  62.                ::
  63.                     LENCOMP #1- SIX #/ SWAPDROP #1+
  64.                     FOUR #MIN
  65.                ;
  66.                :: DROP FOUR ;
  67.           xmlines!
  68.      ;
  69.  
  70. ** This sub-routine is stored in 4LAM to reduce the size and
  71. ** speed up the key handler.  It also make the source file
  72. ** more readable
  73. ** STACK ON INPUT:  #key #plane
  74.  
  75.      '         ( define menu key evaluator sub-program )
  76.           ::
  77.                SetDA2aBad
  78.  
  79. ************************************************************
  80. **
  81. **  Including this section of code will cause XMENU to exit
  82. **  when a key is pressed that is assigned to a menu label.
  83. **  Leaving this section commented will force XMENU to exit
  84. **  only when [ON] is pressed.
  85. *
  86. *              TRUE xmexit!
  87. *
  88. ************************************************************
  89.  
  90. ( get and eval keyob )
  91.  
  92.                MenuDef@ MenuRow@   ( cache old MenuInfo )
  93.                { NULLLAM NULLLAM }
  94.                BIND
  95.                Key>StdKeyOb        ( Get keyob and eval )
  96.                EVAL
  97.                2GETLAM 1GETABND    ( push old menu info )
  98.  
  99. ( compare old and new menus )
  100.  
  101.                OVER MenuDef@ EQUAL ( old/new menu same? )
  102.                NOTcasedrop         ( no, add to path )
  103.                ::
  104.                     xmpath@ INNERCOMP
  105.                     get1 SWAP#1+        ( add old MenuDef )
  106.                     xmrow@ SWAP#1+      ( add old menu row )
  107.                     {}N xmpath!
  108.                     getlines@ EVAL      ( init MenuLines )
  109.                     ClrDAsOK       ( flag display refresh )
  110.                ;
  111.                SWAPDROP MenuRow@ EQUAL ( old/new row same? )
  112.                NOT?SEMI            ( rows dif, then SEMI )
  113.                xmrow@ MenuRow!     ( restore first MenuRow )
  114.  
  115.           ;
  116.  
  117.           FOUR
  118.           ONE NULL{} FalseFalse
  119.           {
  120.                NULLLAM NULLLAM NULLLAM NULLLAM
  121.                NULLLAM NULLLAM NULLLAM
  122.           }
  123.           BIND
  124.  
  125.  
  126.           ONE MenuRow!             ( init MenuRow )
  127.           getlines@ EVAL           ( init MenuLines )
  128.  
  129.  
  130.           '
  131.  
  132. *** Application Display Routine ****
  133.  
  134.           ::
  135.                TOADISP             ( force ABUFF )
  136.  
  137. ( Status Display )
  138.  
  139.                DA1OK?NOTIT ?DispStatus
  140.  
  141. ( Stack Display )
  142.  
  143.                DA2aOK?NOTIT
  144.                     ::
  145.                          KEYINBUFFER? case SetDA2aBad
  146.                          NINETEEN !DcompWidth
  147.                          SIX xmlines@ #-
  148.                          #1+_ONE_DO (DO)
  149.                               INDEX@ #:>$
  150.                               DEPTH #1- INDEX@ #< ?SKIP
  151.                               ::
  152.                                    INDEX@ #1+PICK
  153.                                    1stkdecomp$w &$
  154.                               ;
  155.                               NINE xmlines@ #- INDEX@#-
  156.                               DISPN
  157.                          LOOP
  158.                          ClrDA2aBad
  159.                     ;
  160.  
  161. ( Menu Display )
  162.  
  163.                DA3OK?NOTIT
  164.                ::
  165.                     KEYINBUFFER? case SetDA3Bad
  166.                     TURNMENUOFF         ( hide menu )
  167.                     TRUE xmnext!        ( init next )
  168.                     SetThisRow          ( Set top row )
  169.                     MenuRow@ xmrow!   ( save top row )
  170.                     xmlines@
  171. ( Row loop )
  172.                     #1+_ONE_DO (DO)
  173.                          xmnext@ IT
  174.  
  175. ( Display labels on menu grob [which is hidden] )
  176.  
  177.                          ::
  178.                               # 6E  # 58 FOURTWO FORTYFOUR
  179.                               TWENTYTWO ZERO
  180. ( Label loop )
  181.                               SEVEN ONE_DO (DO)
  182.                                    INDEX@ GETDF DoLabel
  183.                               LOOP
  184.                          ;
  185.  
  186. ( GROB! menu grob on display grob [ABUFF or GBUFF] )
  187.  
  188.                          HARDBUFF2 HARDBUFF
  189.                          #ZERO#SEVEN
  190.                          xmlines@ #- INDEX@ #+ #8*
  191.                          GROB!
  192.  
  193. ( Advance MenuRow. )
  194. ( If row raps around to 1 clear menu and flag )
  195.  
  196.                          DoNextRow MenuRow@ #1= IT
  197.                               :: FALSE xmnext! CLEARMENU ;
  198.  
  199.                     LOOP
  200.                     xmrow@ MenuRow!     ( restore 1st row )
  201.  
  202. ( display XMENU and prev/next indicators )
  203.  
  204.                     "X"
  205.                     xmrow@ #1<> IT      ( TopRow>1? )
  206.                          :: "\90" &$ ;
  207.                     xmnext@ IT          ( more rows? )
  208.                           :: "\8F" &$ ;
  209.                     THIRTYNINE THIRTYSEVEN FIFTYSIX
  210.                     Blank&GROB!
  211.                     SetDA3Valid
  212.                ;
  213.                ClrDAsOK
  214.           ;
  215.  
  216.           '
  217. *** Application Key Handler *****
  218.  
  219.           ::
  220.  
  221.                DUP THREE #> case2drop   ( non alpha? )
  222.                     'DoBadKeyT
  223.                SWAP
  224.                THIRTYFIVE #=casedrop              ( LSHIFT )
  225.                     DROPFALSE
  226.                FORTY #=casedrop                   ( RSHIFT )
  227.                     DROPFALSE
  228.                FORTYFIVE #=casedrop               ( ON )
  229.                     :: #3= caseFALSE
  230.                          '
  231.                          :: TakeOver TRUE xmexit! ;
  232.                          TRUE
  233.                     ;
  234.                TWENTYFIVE #=casedrop              ( ENTER )
  235.                     ::
  236.                          ONE ?CaseKeyDef     ( do next )
  237.                               ::   TakeOver
  238.                                    TWENTYFOUR SetSomeRow
  239.                               ;
  240.                          TWO ?CaseKeyDef     ( do prev )
  241.                               ::   TakeOver
  242.                                    # FFFE8 SetSomeRow
  243.                               ;
  244.  
  245.                          DROP' DoFirstRow TRUE
  246.                     ;
  247.                TWENTYSIX #=casedrop               ( +/- )
  248.                     ::
  249.                          ONE ?CaseKeyDef     ( do UpMenu )
  250.                               ::   TakeOver
  251.                                    xmpath@ INNERCOMP
  252.                                    DUP#0=csedrp DoBadKey
  253.                                    #2- UNROT StartMenu
  254.                                    getlines@ EVAL
  255.                                    {}N xmpath!
  256.                                    ClrDAsOK
  257.                               ;
  258.                          TWO ?CaseKeyDef     ( do updir )
  259.                               :: TakeOver UPDIR ;
  260.  
  261.                          DROP'               ( do HomeMenu )
  262.                               ::   TakeOver xmpath@
  263.                                    DUPNULL{}? casedrop
  264.                                         DoBadKey
  265.                                    NULL{} xmpath!
  266.                                    INNERCOMP #2- NDROP
  267.                                    StartMenu
  268.                                    getlines@ EVAL
  269.                                    ClrDAsOK
  270.                               ;
  271.                          TRUE
  272.                     ;
  273.                DUP TWENTYFIVE #> case2drop   ( key<25? )
  274.                     'DoBadKeyT
  275.  
  276.                #1- SIX #/ SWAP#1+SWAP
  277.                #6* xmrow@ SWAPOVER #+DUP
  278.  
  279. ( STACK: #plane, #menukey[1-6], #oldrow, #newrow, #newrow )
  280.  
  281.                MenuRow! SetThisRow
  282.                MenuRow@ #<>case
  283.  
  284. ( row not defined, restore old row and DoBadKey )
  285.  
  286.                     :: MenuRow! 2DROP 'DoBadKeyT ;
  287.                DROPSWAP
  288.                ' TakeOver UNROT    ( add 'Takeover' to top )
  289.                domnukey@ FOUR ::N  ( Build secondary )
  290.                TRUE
  291.  
  292. ************************************************************
  293. **
  294. **  THIS NEXT SECTION IS OPTIONAL.  IF YOU WOULD LIKE TO USE
  295. **  IT THEN UNCOMMMENT THE LINES OF CODE.
  296. **
  297. **  The following code toggles the label of the menu key
  298. **  that was pressed by inverting it twice.  It uses the
  299. **  fact that three [#key/#plane] sets are really on the
  300. **  stack when the key handler is called, although the key
  301. **  handler must consume only the bottom pair and leave the
  302. **  top two alone.  4PICK on the first line of code gets the
  303. **  #key from the second [#key/#plane] set.
  304. *
  305. *
  306. *              HARDBUFF 4PICK
  307. *              #1- SIX #/ SWAP TWENTYTWO #*
  308. *              SWAP #8* THIRTYTHREE #+ THREE NDUP
  309. *              OVER TWENTYONE #+ OVER SEVEN #+ SUBGROB
  310. *              FOUR NDUP INVGROB 4UNROLL GROB!
  311. *              SLOW SLOW INVGROB 4UNROLL GROB!
  312.  
  313. ************************************************************
  314.  
  315.           ;
  316.  
  317.           TrueTrue FALSE ONEFALSE'
  318.           1GETLAM 'ERRJMP
  319.           POLSetUI ClrDAsOK
  320.           POLKeyUI
  321.           ABND
  322.           MenuDef@ MenuRow@        ( push appl. menu_info )
  323.      ;
  324.      ERRTRAP
  325.      POLResUI&Err POLRestoreUI
  326.      StartMenu                     ( set last appl. menu )
  327.      DispMenu SHRINKVDISP     ( display menu, resize ABUFF )
  328.      ClrDAsOK SetDA2aBad
  329. ;
  330.